home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / thread.bas < prev    next >
Encoding:
BASIC Source File  |  1997-06-14  |  2.2 KB  |  89 lines
  1. Attribute VB_Name = "MThread"
  2. Option Explicit
  3.  
  4. Declare Sub ExitThread Lib "KERNEL32" ( _
  5.     ByVal dwExitCode As Long)
  6.     
  7. Declare Sub CloseHandle Lib "KERNEL32" ( _
  8.     ByVal h As Long)
  9.     
  10. Declare Function GetExitCodeThread Lib "KERNEL32" ( _
  11.     ByVal hThread As Long, _
  12.     ByRef lpExitCode As Long) As Long
  13.  
  14. Declare Function CreateThread Lib "KERNEL32" ( _
  15.     ByRef lpThreadAttributes As Any, _
  16.     ByVal dwStackSize As Long, _
  17.     ByVal lpStartAddress As Long, _
  18.     ByRef lpParameter As Any, _
  19.     ByVal dwCreationFlags As Long, _
  20.     ByRef lpThreadId As Long) As Long
  21.  
  22. Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Long)
  23.  
  24. Declare Function GetTickCount Lib "KERNEL32" () As Long
  25.  
  26. Const STILL_ACTIVE = 259
  27. Const pNull As Long = 0
  28.  
  29. Private fRunning As Boolean
  30. Private cCalc As Long
  31. Private cAPI As Long
  32. Private datBasic As Date
  33. Private hThread As Long
  34. Private idThread As Long
  35.  
  36. Sub StartThread(ByVal i As Long)
  37.     ' Signal that thread is starting
  38.     fRunning = True
  39.     ' Create new thread
  40.     hThread = CreateThread(ByVal pNull, 0, AddressOf ThreadProc, _
  41.                            ByVal i, 0, idThread)
  42.     If hThread = 0 Then MsgBox "Can't start thread"
  43. End Sub
  44.  
  45. Function StopThread() As Long
  46.     ' Signal thread to stop
  47.     fRunning = False
  48.     ' Make sure thread is dead before returning exit code
  49.     Do
  50.         Call GetExitCodeThread(hThread, StopThread)
  51.     Loop While StopThread = STILL_ACTIVE
  52.     CloseHandle hThread
  53.     hThread = 0
  54. End Function
  55.  
  56. Function ThreadRunning() As Boolean
  57.     ThreadRunning = fRunning
  58. End Function
  59.  
  60. Function CalcCount() As Long
  61.     CalcCount = cCalc
  62. End Function
  63.  
  64. Function APICount() As Long
  65.     APICount = cAPI
  66. End Function
  67.  
  68. Function BasicTime() As Date
  69.     BasicTime = datBasic
  70. End Function
  71.  
  72. Sub ThreadProc(ByVal i As Long)
  73.     ' Use parameter
  74.     cCalc = i
  75.     Do While fRunning
  76.         ' Calculate something
  77.         cCalc = cCalc + 1
  78.         ' Use an API call
  79.         cAPI = GetTickCount
  80.         ' Use a Basic function
  81.         datBasic = Now
  82.         ' Switch immediately to another thread
  83.         Sleep 1
  84.     Loop
  85.     ' Return a value
  86.     ExitThread cCalc
  87. End Sub
  88. '
  89.